Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Snippets/PNL Libraries/MyDatabase.p

Text File | 1997-04-13 | 22.8 KB | 811 lines | [TEXT/CWIE]

unit MyDatabase;

interface

    uses
        Types, Files;

    const
        DB_Normal = 0;
        DB_CaseSensitive = $00000001;
        DB_Null = 0;

    const
        fileFormatErr = -10;
        duplicateKeyErr = -11;
        keyNotFoundErr = -12;

    function DatabaseCreate (var fs: FSSpec; hashsize: integer; flags: longint): OSErr;
{ You should create the file before calling this using FSpCreate.  Any existing data will be destroyed. }
{ hashsize is the number of hash table entries (initial file size will be around 4*hashsize }
{ hashsize should be prime }
    function DatabaseOpen (var fs: FSSpec; var refnum: longint): OSErr;
    function DatabaseFlush (refnum: longint): OSErr;
    function DatabaseClose (refnum: longint): OSErr;
    function DatabaseAdd (refnum: longint; key: Str255; data: Handle; overwriteok: boolean): OSErr;
    function DatabaseSetInfo (refnum: longint; key: Str255; var id: longint; size: longint; overwriteok: boolean): OSErr;
    function DatabaseSetChunk (refnum: longint; id: longint; pos: longint; data: Handle): OSErr;
    function DatabaseGet (refnum: longint; key: Str255; data: Handle): OSErr; { data may be nil }
    function DatabaseGetInfo (refnum: longint; key: Str255; var id: longint; var size: longint): OSErr;
    function DatabaseGetChunk (refnum: longint; id: longint; pos, len: longint; data: Handle): OSErr;
    function DatabaseDelete (refnum: longint; key: Str255; data: Handle): OSErr; { data may be nil }
    function DatabaseIndex (refnum: longint; var pos: longint; var key: Str255; data: Handle): OSErr;
{ pass in zero the first time, then whatever you got last time to get next.   data may be nil }
    function DatabasePack (refnum: longint; fix: boolean): OSErr;
{ uses about hashsize*8+8k memory in the heap }
    function DatabaseValidate ( refnum: longint; fix_minor_errors: boolean; var minor_errors: boolean ): OSErr;

implementation

    uses
        Memory, Packages, TextUtils,
        MyFileSystemUtils, MyMemory, MyAssertions;

    const
        File_Magic = 'PLDB';
        Current_Version = 1;
        Max_Hash = 30011;
        free_next = -1;

{ File format: }
{ magic:longint }
{ version: longint }
{ flags:longint }
{ hashsize: integer}
{ hashtable: array[1..hashsize] of entryptr (offset into file) }
{ entry is: }
{ next:entryptr }
{ keylen:integer }
{ datalen:longint }
{ key:bytes }
{ data:bytes }
{ free entries have next=-1.  next links always point further into the file, never backwards }

{$PUSH}
{$ALIGN MAC68K}

    type
        ShortFileHeader = record
                magic: OSType;
                version: longint;
                flags: longint;
                hashsize: integer;
                rn: integer; { not valid in file obviously }
            end;
        HashTableArray = array[0..Max_Hash] of longint;
        LongFileHeader = record
                magic: OSType;
                version: longint;
                flags: longint;
                hashsize: integer;
                rn: integer; { not valid in file obviously }
                hashtable: HashTableArray;
            end;
        FileHeaderPtr = ^LongFileHeader;
        FileHeaderHandle = ^FileHeaderPtr;
        HashTablePtr = ^HashTableArray;
        EntryRecord = record
                next: longint;
                keylen: integer;
                datalen: longint;
            end;

{$ALIGN RESET}
{$POP}

    const
        File_Header_Size = SizeOf(ShortFileHeader);
        Entry_Size = SizeOf(EntryRecord);

    procedure AddOSErr( var err: OSErr; newerr: OSErr );
    begin
        if err = noErr then begin
            err := newerr;
        end;
    end;

    function DatabaseCreate (var fs: FSSpec; hashsize: integer; flags: longint): OSErr;
        var
            err, oerr: OSErr;
            fhp: FileHeaderPtr;
            count: longint;
            rn: integer;
            i: integer;
    begin
        if hashsize > Max_Hash then begin
            hashsize := Max_Hash;
        end;
        count := File_Header_Size + 4 * longint(hashsize);
        err := FSpOpenDF(fs, fsRdWrPerm, rn);
        if err = noErr then begin
            err := SetEOF(rn, count);
            if err = noErr then
                err := MNewPtr(fhp, count);
            if err = noErr then begin
                fhp^.magic := File_Magic;
                fhp^.version := Current_Version;
                fhp^.flags := flags;
                fhp^.hashsize := hashsize;
                for i := 0 to hashsize - 1 do begin
                    fhp^.hashtable[i] := 0;
                end;
                err := FSWrite(rn, count, Ptr(fhp));
                MDisposePtr(fhp);
            end;
            oerr := FSClose(rn);
            if err = noErr then
                err := oerr;
        end;
        DatabaseCreate := err;
    end;

    function DatabaseOpen (var fs: FSSpec; var refnum: longint): OSErr;
        var
            err, junk: OSErr;
            fh: ShortFileHeader;
            rn: integer;
            count: longint;
            fhp: FileHeaderPtr;
    begin
        err := FSpOpenDF(fs, fsRdWrPerm, rn);
        if err = noErr then begin
            count := File_Header_Size;
            err := FSRead(rn, count, @fh);
            if err = noErr then begin
                if (fh.magic <> File_magic) or (fh.version <> Current_Version) or (fh.hashsize < 1) or (fh.hashsize > Max_Hash) then begin
                    err := fileFormatErr;
                end;
            end;
            if err = noErr then begin
                count := 4 * longint(fh.hashsize);
                err := MNewPtr(fhp, File_header_Size + count);
            end;
            if err = noErr then begin
                BlockMove(@fh, Ptr(fhp), File_Header_Size);
                fhp^.rn := rn;
                err := FSRead(rn, count, Ptr(ord(fhp) + File_Header_Size));
                if err <> noErr then begin
                    MDisposePtr(fhp);
                end;
            end;
            if err <> noErr then begin
                junk := FSClose(rn);
            end;
        end;
        refnum := longint(fhp);
        if err <> noErr then begin
            refnum := DB_Null;
        end;
        DatabaseOpen := err;
    end;

    function DatabaseFlush (refnum: longint): OSErr;
        var
            err: OSErr;
            fhp: FileHeaderptr;
            pb: ParamBlockRec;
    begin
        fhp := FileHeaderPtr(refnum);
        err := MyFSWriteAt(fhp^.rn, fsFromStart, 0, GetPtrSize(Ptr(fhp)), Ptr(fhp));
        if err = noErr then begin
            pb.ioRefNum := fhp^.rn;
            err := PBFlushFileSync(@pb);
        end;
        DatabaseFlush := err;
    end;

    function DatabaseClose (refnum: longint): OSErr;
        var
            err, oerr: OSErr;
            fhp: FileHeaderptr;
    begin
        fhp := FileHeaderPtr(refnum);
        err := MyFSWriteAt(fhp^.rn, fsFromStart, 0, GetPtrSize(Ptr(fhp)), Ptr(fhp));
        oerr := FSClose(fhp^.rn);
        if err = noErr then
            err := oerr;
        MDisposePtr(fhp);
        DatabaseClose := err;
    end;

    function Hash (var key: Str255; hashsize: integer): integer;
        var
            h, i: integer;
    begin
        h := 0;
        for i := 1 to length(key) do begin
            h := ((32 * longint(h)) + ord(key[i])) mod hashsize;
        end;
        Hash := h;
    end;

    function ReadEntry (fhp: FileHeaderPtr; pos: longint; var entry: EntryRecord; var key: Str255): OSErr;
        var
            err: OSErr;
    begin
        err := MyFSReadAt(fhp^.rn, pos, Entry_Size, @entry);
        if err = noErr then begin
{$PUSH}
{$R-}
            key[0] := chr(entry.keylen);
{$POP}
            Assert( (entry.keylen > 0) & (entry.keylen <= 255) );
            if (entry.keylen > 0) & (entry.keylen <= 255) then begin
                err := MyFSReadAt(fhp^.rn, pos + Entry_Size, entry.keylen, @key[1]);
            end else begin
                err := fileFormatErr;
            end;
        end;
        ReadEntry := err;
    end;

    function Find (fhp: FileHeaderPtr; var key: Str255; var h: integer; var preoffset, offset: longint; var entry: EntryRecord): OSErr;
{ err = noErr ==> no error.  offset<>0 ==> found. preoffset is the fileoffset that points to offset (even if not found) }
        var
            err: OSErr;
            thiskey: Str255;
    begin
        h := Hash(key, fhp^.hashsize);
        preoffset := File_Header_Size + 4 * longint(h);
        offset := fhp^.hashtable[h];
        err := noErr;
        while (offset <> 0) & (err = noErr) do begin
            err := ReadEntry(fhp, offset, entry, thiskey);
            if err = noErr then begin
                if BAND(fhp^.flags, DB_CaseSensitive) <> 0 then begin
                    if thiskey = key then begin
                        leave;
                    end;
                end else begin
                    if IUEqualString(thiskey, key) = 0 then begin
                        leave;
                    end;
                end;
                preoffset := offset;
                offset := entry.next;
            end;
        end;
        Find := err;
    end;

    function WriteLink (fhp: FileHeaderPtr; pos: longint; link: longint): OSErr;
        var
            h: integer;
            err: OSErr;
    begin
        if pos >= File_Header_Size + 4 * longint(fhp^.hashsize) then begin
            err := MyFSWriteAt(fhp^.rn, fsFromStart, pos, 4, @link);
        end else begin
            err := noErr;
            h := (pos - File_Header_size) div 4;
            fhp^.hashtable[h] := link;
        end;
        WriteLink := err;
    end;

    function WriteFreeLink (fhp: FileHeaderPtr; pos: longint): OSErr;
        var
            link: longint;
    begin
        link := free_next;
        WriteFreeLink := MyFSWriteAt(fhp^.rn, fsFromStart, pos, 4, @link);
    end;

    function FindSpace (fhp: FileHeaderptr; key: Str255; size: longint; overwriteok: boolean; var offset: longint): OSErr;
        var
            err: OSErr;
            h: integer;
            preoffset, v: longint;
            entry: EntryRecord;
            filelen: longint;
            oldsize: longint;
    begin
        err := Find(fhp, key, h, preoffset, offset, entry);
        if (err = noErr) & (offset <> 0) & not overwriteok then
            err := duplicateKeyErr;
        if (err = noErr) & (offset <> 0) then begin
            if entry.datalen = size then begin
{ all set }
            end else if entry.datalen > size + Entry_Size then begin
                oldsize := entry.datalen;
                entry.datalen := size;
                err := MyFSWriteAt(fhp^.rn, fsFromStart, offset, Entry_Size, @entry);
                if err = noErr then begin
                    entry.next := free_next;
                    entry.keylen := 0;
                    entry.datalen := oldsize - size - Entry_Size;
                    err := MyFSWriteAt(fhp^.rn, fsFromStart, offset + Entry_Size + length(key) + size, Entry_Size, @entry);
                end;
            end else begin
                err := WriteLink(fhp, preoffset, entry.next);
                v := free_next;
                if err = noErr then
                    err := WriteFreeLink(fhp, offset);
                offset := entry.next;
                while (offset <> 0) & (err = noErr) do begin
                    err := MyFSReadAt(fhp^.rn, offset, 4, @entry);
                    if err = noErr then begin
                        preoffset := offset;
                        offset := entry.next;
                    end;
                end;
            end;
        end;
        if (err = noErr) & (offset = 0) then begin { add at end of file after entry at preoffset }
            err := GetEOF(fhp^.rn, filelen);
            if err = noErr then begin
                err := SetEOF(fhp^.rn, filelen + Entry_Size + length(key) + size);
            end;
            entry.next := 0;
            entry.keylen := length(key);
            entry.datalen := size;
            if err = noErr then
                err := MyFSWriteAt(fhp^.rn, fsFromStart, filelen, Entry_Size, @entry);
            if err = noErr then
                err := MyFSWrite(fhp^.rn, length(key), @key[1]);
            if err = noErr then begin
                err := WriteLink(fhp, preoffset, filelen);
            end;
            offset := filelen;
        end;
        offset := offset + Entry_Size + length(key);
        FindSpace := err;
    end;

    function DatabaseAdd (refnum: longint; key: Str255; data: Handle; overwriteok: boolean): OSErr;
        var
            err: OSErr;
            fhp: FileHeaderptr;
            offset: longint;
            handlesize: longint;
            state: SignedByte;
    begin
        fhp := FileHeaderPtr(refnum);
        handlesize := GetHandleSize(data);
        err := FindSpace(fhp, key, handlesize, overwriteok, offset);
        if err = noErr then begin
            HLockState(data, state);
            err := MyFSWriteAt(fhp^.rn, fsFromStart, offset, handlesize, data^);
            HSetState(data, state);
        end;
        DatabaseAdd := err;
    end;

    function DatabaseSetInfo (refnum: longint; key: Str255; var id: longint; size: longint; overwriteok: boolean): OSErr;
        var
            err: OSErr;
            fhp: FileHeaderptr;
    begin
        fhp := FileHeaderPtr(refnum);
        err := FindSpace(fhp, key, size, overwriteok, id);
        DatabaseSetInfo := err;
    end;

    function DatabaseSetChunk (refnum: longint; id: longint; pos: longint; data: Handle): OSErr;
        var
            err: OSErr;
            fhp: FileHeaderptr;
            state: SignedByte;
    begin
        fhp := FileHeaderPtr(refnum);
        HLockState(data, state);
        err := MyFSWriteAt(fhp^.rn, fsFromStart, id + pos, GetHandleSize(data), data^);
        HSetState(data, state);
        DatabaseSetChunk := err;
    end;

    function Get (fhp: FileHeaderPtr; var key: Str255; var h: integer; var preoffset, offset: longint; var entry: EntryRecord; data: Handle): OSErr;
        var
            err: OSErr;
            state: SignedByte;
    begin
        err := Find(fhp, key, h, preoffset, offset, entry);
        if (err = noErr) & (offset = 0) then
            err := keyNotFoundErr;
        if err = noErr then begin
            if data <> nil then begin
                HUnlockState(data, state);
                SetHandleSize(data, entry.datalen);
                err := MemError;
                if err = noErr then begin
                    HLock(data);
                    err := MyFSReadAt(fhp^.rn, offset + Entry_Size + entry.keylen, entry.datalen, data^);
                end;
                HSetState(data, state);
            end;
        end;
        Get := err;
    end;

    function DatabaseGet (refnum: longint; key: Str255; data: Handle): OSErr;
        var
            h: integer;
            preoffset, offset: longint;
            entry: EntryRecord;
    begin
        DatabaseGet := Get(FileHeaderPtr(refnum), key, h, preoffset, offset, entry, data);
    end;

    function DatabaseGetInfo (refnum: longint; key: Str255; var id: longint; var size: longint): OSErr;
        var
            h: integer;
            preoffset, offset: longint;
            entry: EntryRecord;
    begin
        DatabaseGetInfo := Get(FileHeaderPtr(refnum), key, h, preoffset, offset, entry, nil);
        id := offset + Entry_Size + entry.keylen;
        size := entry.datalen;
    end;

    function DatabaseGetChunk (refnum: longint; id: longint; pos, len: longint; data: Handle): OSErr;
        var
            err: OSErr;
            state: SignedByte;
    begin
        HUnlockState(data, state);
        SetHandleSize(data, len);
        err := MemError;
        if err = noErr then begin
            HLock(data);
            err := MyFSReadAt(FileHeaderPtr(refnum)^.rn, id + pos, len, data^);
        end;
        HSetState(data, state);
        DatabaseGetChunk := err; { Thanks Marcel/Metrowerks! }
    end;

    function DatabaseDelete (refnum: longint; key: Str255; data: Handle): OSErr; { data may be nil }
        var
            err: OSErr;
            fhp: FileHeaderptr;
            h: integer;
            preoffset, offset: longint;
            entry: EntryRecord;
    begin
        fhp := FileHeaderPtr(refnum);
        err := Get(fhp, key, h, preoffset, offset, entry, data);
        if err = noErr then begin
            err := WriteLink(fhp, preoffset, entry.next);
            if err = noErr then
                err := WriteFreeLink(fhp, offset);
        end;
        DatabaseDelete := err;
    end;

    function DatabaseIndex (refnum: longint; var pos: longint; var key: Str255; data: Handle): OSErr;
        var
            err: OSErr;
            fhp: FileHeaderptr;
            start, filelen: longint;
            entry: EntryRecord;
            count: longint;
    begin
        fhp := FileHeaderPtr(refnum);
        start := File_Header_Size + 4 * longint(fhp^.hashsize);
        if pos = 0 then
            pos := start;
        err := GetEOF(fhp^.rn, filelen);
        entry.next := free_next;
        while (err = noErr) & (entry.next = free_next) & (start <= pos) & (pos < filelen) do begin
            err := ReadEntry(fhp, pos, entry, key);
            pos := pos + Entry_Size + entry.keylen + entry.datalen;
        end;
        if (err = noErr) & (entry.next = free_next) then
            err := keyNotFoundErr;
        if (err = noErr) & (data <> nil) then begin
            SetHandleSize(data, entry.datalen);
            err := MemError;
            if err = noErr then begin
                count := entry.datalen;
                err := FSRead(fhp^.rn, count, data^);
            end;
        end;
        DatabaseIndex := err;
    end;

    function DatabasePack (refnum: longint; fix: boolean): OSErr;
        const
            buffer_size = 8192;
        var
            err: OSErr;
            fhp: FileHeaderptr;
            preoffsets, offsets: HashTablePtr;
            start, filelen: longint;
            srcpos, destpos, nextpos: longint;
            entry: EntryRecord;
            key: Str255;
            len, count: longint;
            buffer: Ptr;
            h: integer;
    begin
        fhp := FileHeaderPtr(refnum);
        err := MNewPtr(preoffsets, 4 * longint(fhp^.hashsize));
        offsets := nil;
        if err = noErr then
            err := MNewPtr(offsets, 4 * longint(fhp^.hashsize));
        buffer := nil;
        if err = noErr then
            err := MNewPtr(buffer, buffer_size);
        start := File_Header_Size + 4 * longint(fhp^.hashsize);
        if err = noErr then
            err := GetEOF(fhp^.rn, filelen);
        if err = noErr then begin
            for h := 0 to fhp^.hashsize - 1 do begin
                preoffsets^[h] := File_header_Size + longint(h) * 4;
                offsets^[h] := fhp^.hashtable[h];
                if fix then begin
                    fhp^.hashtable[h] := 0;
                end;
            end;
            srcpos := start;
            destpos := start;
            while (err = noErr) & (srcpos < filelen) do begin
                err := ReadEntry(fhp, srcpos, entry, key);

                if fix & (err = fileFormatErr) then begin
                    nextpos := filelen;
                    for h := 0 to fhp^.hashsize - 1 do begin
                        if (offsets^[h] > srcpos) & (offsets^[h] < nextpos) then begin
                            nextpos := offsets^[h];
                        end;
                    end;
                    if nextpos < filelen then begin
                        DebugStr( 'Skipping Entry;g' );
                        srcpos := nextpos;
                        err := noErr;
                        cycle;
                    end else begin
                        err := noErr;
                        leave;
                    end;
                end;

                if (err = noErr) then begin
                    len := Entry_Size + entry.keylen + entry.datalen;
                    if (entry.next = free_next) then begin { skip it }
                        srcpos := srcpos + len;
                    end else begin
{ ok, now we need to move this entry from srcpos to destpos, updating the link pointing to it }
{ Find hash }
                        h := Hash(key, fhp^.hashsize);
                        if (offsets^[h] <> srcpos) & not fix then begin
                            err := fileFormatErr;
                        end;
{ Update link }
                        if err = noErr then begin
                            err := WriteLink(fhp, preoffsets^[h], destpos);
                        end;
                        preoffsets^[h] := destpos;
                        offsets^[h] := entry.next;
{ Copy entry }
                        if srcpos = destpos then begin
                            destpos := destpos + len;
                            srcpos := srcpos + len;
                        end else begin
                            while (err = noErr) & (len > 0) do begin
                                count := len;
                                if count > buffer_size then begin
                                    count := buffer_size;
                                end;
                                err := MyFSReadAt(fhp^.rn, srcpos, count, buffer);
                                if err = noErr then begin
                                    err := MyFSWriteAt(fhp^.rn, fsFromStart, destpos, count, buffer);
                                end;
                                len := len - count;
                                srcpos := srcpos + count;
                                destpos := destpos + count;
                            end;
                        end;
                    end;
                end;
            end;
            if err = noErr then begin
                { terminate all chains }
                for h := 0 to fhp^.hashsize - 1 do begin
                    AddOSErr( err, WriteLink( fhp, preoffsets^[h], 0 ) );
                end;
                AddOSErr( err, SetEOF(fhp^.rn, destpos) );
            end;
        end;
        MDisposePtr(preoffsets);
        MDisposePtr(offsets);
        MDisposePtr(buffer);
        DatabasePack := err;
    end;

    function DatabaseValidate ( refnum: longint; fix_minor_errors: boolean; var minor_errors: boolean ): OSErr;
        var
            current: ^HashTableArray;
            fhp: FileHeaderptr;
            pos: longint;
            all_finished: boolean;
        function FindInCurrent( pos: longint ): longint;
            var
                i, j: longint;
        begin
            j := -1;
            for i := 0 to fhp^.hashsize-1 do begin
                if current^[i] = pos then begin
                    if j >= 0 then begin
                        minor_errors := true;
                        writeln( 'Duplicate hash entry pointing at ', pos:1, ' ', i:1, ' ', j:1 );
                    end;
                    j := i;
                end;
            end;
            FindInCurrent := j;
        end;
        function FindCurrent: longint;
        begin
            FindCurrent := FindInCurrent( pos );
        end;
        function FindNext: longint;
            var
                i, j: longint;
        begin
            j := -1;
            for i := 0 to fhp^.hashsize-1 do begin
                if current^[i] > pos then begin
                    if (j < 0) | (current^[i] < current^[j]) then begin
                        j := i;
                    end;
                end;
            end;
            FindNext := j;
        end;

        procedure SetAllFinished;
            var
                i: longint;
        begin
            all_finished := true;
            for i := 0 to fhp^.hashsize-1 do begin
                if current^[i] >= pos then begin
                    all_finished := false;
                end;
            end;
        end;

        procedure SetCurrent( i, what: longint );
            var
                junk: OSErr;
        begin
            if (what > 0) & (FindInCurrent( what ) >= 0) then begin
                minor_errors := true;
                writeln( 'Ignoring duplicate SetCurrent at ', pos:1, ' ', i:1, ' ', FindInCurrent( what ):1, ' ', what:1 );
                if fix_minor_errors then begin
                    junk := WriteLink( fhp, pos, 0 ); { termiate chain }
                end;
                what := 0;
            end;
            current^[i] := what;
            if what <= 0 then begin
                SetAllFinished;
            end;
        end;
        var
            err: OSErr;
            filelen: longint;
            hash_size: longint;
            nextpos: longint;
            entry: EntryRecord;
            i, j: longint;
            key: Str255;
            junk: OSErr;
    begin
        minor_errors := false;
        current := nil;
        fhp := FileHeaderPtr(refnum);
        err := GetEOF( fhp^.rn, filelen );
        if err = noErr then begin
            Assert( filelen >= File_Header_Size );
            hash_size := 4 * longint(fhp^.hashsize);
            err := MNewPtr( current, hash_size);
        end;
        if err = noErr then begin
            BlockMoveData( @fhp^.hashtable, Ptr(current), hash_size );
            pos := File_Header_Size + hash_size;
            SetAllFinished;
            while not all_finished & (pos < filelen) do begin
                err := MyFSReadAt( fhp^.rn, pos, Entry_Size, @entry );
                if err <> noErr then begin
                    writeln( 'DatabaseValidate:MyFSReadAt ', err:1, ' at ', pos:1 );
                    leave;
                end;
                if (entry.keylen <= 0) | (entry.keylen > 255) | (entry.datalen < 0) | (entry.datalen > filelen - pos) then begin
                    j := FindCurrent;
                    i := FindNext;
                    if j > 0 then begin
                        SetCurrent( i, -1 );
                    end;
                    if i > 0 then begin
                        nextpos := current^[i];
                    end else begin
                        nextpos := filelen;
                    end;
                    if fix_minor_errors then begin
                        { blat pos->nextpos }
                        key := 'A';
                        if j < 0 then begin
                            entry.next := free_next;
                        end else begin
                            entry.next := 0;
                            if Hash( key, fhp^.hashsize ) = j then begin { ensure key does not match hash }
                                key := 'B';
                            end;
                        end;
                        entry.keylen := 1;
                        entry.datalen := nextpos - pos - Entry_Size - entry.keylen;
                        junk := MyFSWriteAt( fhp^.rn, fsFromStart, pos, Entry_Size, @entry  );
                        junk := MyFSWriteAt( fhp^.rn, fsFromStart, pos + Entry_Size, 1, @key[1] );
                    end;
                    minor_errors := true;
                    writeln( 'DatabaseValidate:Entry lengths invalid ', pos:1, ' ', i:1, ' ', j:1 );
                    pos := nextpos;
{                    err := fileFormatErr; }
                end else if entry.next = -1 then begin
                    { do nothing }
                    pos := pos + Entry_Size + entry.keylen + entry.datalen;
                end else begin
                    j := FindCurrent;
                    if j < 0 then begin
                        key[0] := chr(entry.keylen);
                        err := MyFSReadAt( fhp^.rn, pos + Entry_Size, entry.keylen, @key[1] );
                        if err <> noErr then begin
                            writeln( 'DatabaseValidate:Search failed, key read failed at ', pos:1, ' ', err:1 );
                            err := fileFormatErr;
                            leave;
                        end;
                        j := Hash( key, fhp^.hashsize );
                        if current^[j] < 0 then begin
                            minor_errors := true;
                            writeln( 'DatabaseValidate:Search failed, relinking at ', pos:1, ' ', j:1 );
                            SetCurrent( j, entry.next );
                        end else if current^[j] = 0 then begin
                            minor_errors := true;
                            writeln( 'DatabaseValidate:Search failed, ignoring at ', pos:1, ' ', j:1 );
                            if fix_minor_errors then begin
                                junk := WriteFreeLink( fhp, pos ); { free entry }
                            end;
                        end else begin
                            writeln( 'DatabaseValidate:Search failed at ', pos:1, ' ', j:1 );
                            if fix_minor_errors then begin
                                junk := WriteFreeLink( fhp, pos ); { free entry }
                            end;
                        end;
                    end else begin
                        SetCurrent( j, entry.next );
                    end;
                    pos := pos + Entry_Size + entry.keylen + entry.datalen;
                end;
            end;
            if (err = noErr) & (pos <> filelen) then begin
                if all_finished then begin
                    writeln( 'DatabaseValidate:Did not end at end  of file, fixed ', pos:1 );
                    if fix_minor_errors then begin
                        junk := SetEOF( fhp^.rn, pos );
                    end;
                end else begin
                    err := fileFormatErr;
                    writeln( 'DatabaseValidate:Did not end at end  of file' );
                end;
            end;
            if (err = noErr) then begin
                for i := 0 to fhp^.hashsize-1 do begin
                    if current^[i] > 0 then begin
                        err := fileFormatErr;
                        writeln( 'DatabaseValidate:Did not use all of hashtable entry ', i:1, ' ', current^[i] );
                    end;
                end;
            end;
        end;
        MDisposePtr( current );
        DatabaseValidate := err;
    end;

end.

{ Edit history }
{11 Dec 95    pnl        Original }
{ 5 May 96    jc            Changes to support large DBs – again, since I lost the original edits }
{ 21 Aug 96    pnl        Added 68k alignment directives, fixed case, merged back in to main source }